home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / perl5000.zip / perl5000 / pp_hot.c < prev    next >
C/C++ Source or Header  |  1994-10-17  |  38KB  |  1,793 lines
  1. /*    pp_hot.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
  12.  * shaking the air.
  13.  *
  14.  *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
  15.  *                     Fire, Foes!  Awake!
  16.  */
  17.  
  18. #include "EXTERN.h"
  19. #include "perl.h"
  20.  
  21. /* Hot code. */
  22.  
  23. PP(pp_const)
  24. {
  25.     dSP;
  26.     XPUSHs(cSVOP->op_sv);
  27.     RETURN;
  28. }
  29.  
  30. PP(pp_nextstate)
  31. {
  32.     curcop = (COP*)op;
  33.     TAINT_NOT;        /* Each statement is presumed innocent */
  34.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  35.     FREETMPS;
  36.     return NORMAL;
  37. }
  38.  
  39. PP(pp_gvsv)
  40. {
  41.     dSP;
  42.     EXTEND(sp,1);
  43.     if (op->op_private & OPpLVAL_INTRO)
  44.     PUSHs(save_scalar(cGVOP->op_gv));
  45.     else
  46.     PUSHs(GvSV(cGVOP->op_gv));
  47.     RETURN;
  48. }
  49.  
  50. PP(pp_null)
  51. {
  52.     return NORMAL;
  53. }
  54.  
  55. PP(pp_pushmark)
  56. {
  57.     PUSHMARK(stack_sp);
  58.     return NORMAL;
  59. }
  60.  
  61. PP(pp_stringify)
  62. {
  63.     dSP; dTARGET;
  64.     STRLEN len;
  65.     char *s;
  66.     s = SvPV(TOPs,len);
  67.     sv_setpvn(TARG,s,len);
  68.     SETTARG;
  69.     RETURN;
  70. }
  71.  
  72. PP(pp_gv)
  73. {
  74.     dSP;
  75.     XPUSHs((SV*)cGVOP->op_gv);
  76.     RETURN;
  77. }
  78.  
  79. PP(pp_and)
  80. {
  81.     dSP;
  82.     if (!SvTRUE(TOPs))
  83.     RETURN;
  84.     else {
  85.     --SP;
  86.     RETURNOP(cLOGOP->op_other);
  87.     }
  88. }
  89.  
  90. PP(pp_sassign)
  91. {
  92.     dSP; dPOPTOPssrl;
  93.     if (op->op_private & OPpASSIGN_BACKWARDS) {
  94.     SV *temp;
  95.     temp = left; left = right; right = temp;
  96.     }
  97.     if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
  98.                 !mg_find(left, 't'))) {
  99.     TAINT_NOT;
  100.     }
  101.     SvSetSV(right, left);
  102.     SvSETMAGIC(right);
  103.     SETs(right);
  104.     RETURN;
  105. }
  106.  
  107. PP(pp_cond_expr)
  108. {
  109.     dSP;
  110.     if (SvTRUEx(POPs))
  111.     RETURNOP(cCONDOP->op_true);
  112.     else
  113.     RETURNOP(cCONDOP->op_false);
  114. }
  115.  
  116. PP(pp_unstack)
  117. {
  118.     I32 oldsave;
  119.     TAINT_NOT;        /* Each statement is presumed innocent */
  120.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  121.     FREETMPS;
  122.     oldsave = scopestack[scopestack_ix - 1];
  123.     LEAVE_SCOPE(oldsave);
  124.     return NORMAL;
  125. }
  126.  
  127. PP(pp_seq)
  128. {
  129.     dSP; tryAMAGICbinSET(seq,0); 
  130.     {
  131.       dPOPTOPssrl;
  132.       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
  133.       RETURN;
  134.     }
  135. }
  136.  
  137. PP(pp_concat)
  138. {
  139.     dSP; dATARGET; dPOPTOPssrl;
  140.     STRLEN len;
  141.     char *s;
  142.     if (TARG != left) {
  143.     s = SvPV(left,len);
  144.     sv_setpvn(TARG,s,len);
  145.     }
  146.     s = SvPV(right,len);
  147.     sv_catpvn(TARG,s,len);
  148.     SETTARG;
  149.     RETURN;
  150. }
  151.  
  152. PP(pp_padsv)
  153. {
  154.     dSP; dTARGET;
  155.     XPUSHs(TARG);
  156.     if (op->op_private & OPpLVAL_INTRO)
  157.     SAVECLEARSV(curpad[op->op_targ]);
  158.     RETURN;
  159. }
  160.  
  161. PP(pp_readline)
  162. {
  163.     last_in_gv = (GV*)(*stack_sp--);
  164.     return do_readline();
  165. }
  166.  
  167. PP(pp_eq)
  168. {
  169.     dSP; tryAMAGICbinSET(eq,0); 
  170.     {
  171.       dPOPnv;
  172.       SETs((TOPn == value) ? &sv_yes : &sv_no);
  173.       RETURN;
  174.     }
  175. }
  176.  
  177. PP(pp_preinc)
  178. {
  179.     dSP;
  180.     sv_inc(TOPs);
  181.     SvSETMAGIC(TOPs);
  182.     return NORMAL;
  183. }
  184.  
  185. PP(pp_or)
  186. {
  187.     dSP;
  188.     if (SvTRUE(TOPs))
  189.     RETURN;
  190.     else {
  191.     --SP;
  192.     RETURNOP(cLOGOP->op_other);
  193.     }
  194. }
  195.  
  196. PP(pp_add)
  197. {
  198.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  199.     {
  200.       dPOPTOPnnrl;
  201.       SETn( left + right );
  202.       RETURN;
  203.     }
  204. }
  205.  
  206. PP(pp_aelemfast)
  207. {
  208.     dSP;
  209.     AV *av = GvAV((GV*)cSVOP->op_sv);
  210.     SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
  211.     PUSHs(svp ? *svp : &sv_undef);
  212.     RETURN;
  213. }
  214.  
  215. PP(pp_join)
  216. {
  217.     dSP; dMARK; dTARGET;
  218.     MARK++;
  219.     do_join(TARG, *MARK, MARK, SP);
  220.     SP = MARK;
  221.     SETs(TARG);
  222.     RETURN;
  223. }
  224.  
  225. PP(pp_pushre)
  226. {
  227.     dSP;
  228.     XPUSHs((SV*)op);
  229.     RETURN;
  230. }
  231.  
  232. /* Oversized hot code. */
  233.  
  234. PP(pp_print)
  235. {
  236.     dSP; dMARK; dORIGMARK;
  237.     GV *gv;
  238.     IO *io;
  239.     register FILE *fp;
  240.  
  241.     if (op->op_flags & OPf_STACKED)
  242.     gv = (GV*)*++MARK;
  243.     else
  244.     gv = defoutgv;
  245.     if (!(io = GvIO(gv))) {
  246.     if (dowarn)
  247.         warn("Filehandle %s never opened", GvNAME(gv));
  248.     errno = EBADF;
  249.     goto just_say_no;
  250.     }
  251.     else if (!(fp = IoOFP(io))) {
  252.     if (dowarn)  {
  253.         if (IoIFP(io))
  254.         warn("Filehandle %s opened only for input", GvNAME(gv));
  255.         else
  256.         warn("print on closed filehandle %s", GvNAME(gv));
  257.     }
  258.     errno = EBADF;
  259.     goto just_say_no;
  260.     }
  261.     else {
  262.     MARK++;
  263.     if (ofslen) {
  264.         while (MARK <= SP) {
  265.         if (!do_print(*MARK, fp))
  266.             break;
  267.         MARK++;
  268.         if (MARK <= SP) {
  269.             if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
  270.             MARK--;
  271.             break;
  272.             }
  273.         }
  274.         }
  275.     }
  276.     else {
  277.         while (MARK <= SP) {
  278.         if (!do_print(*MARK, fp))
  279.             break;
  280.         MARK++;
  281.         }
  282.     }
  283.     if (MARK <= SP)
  284.         goto just_say_no;
  285.     else {
  286.         if (orslen)
  287.         if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
  288.             goto just_say_no;
  289.  
  290.         if (IoFLAGS(io) & IOf_FLUSH)
  291.         if (fflush(fp) == EOF)
  292.             goto just_say_no;
  293.     }
  294.     }
  295.     SP = ORIGMARK;
  296.     PUSHs(&sv_yes);
  297.     RETURN;
  298.  
  299.   just_say_no:
  300.     SP = ORIGMARK;
  301.     PUSHs(&sv_undef);
  302.     RETURN;
  303. }
  304.  
  305. PP(pp_rv2av)
  306. {
  307.     dSP; dPOPss;
  308.  
  309.     AV *av;
  310.  
  311.     if (SvROK(sv)) {
  312.       wasref:
  313.     av = (AV*)SvRV(sv);
  314.     if (SvTYPE(av) != SVt_PVAV)
  315.         DIE("Not an ARRAY reference");
  316.     if (op->op_private & OPpLVAL_INTRO)
  317.         av = (AV*)save_svref((SV**)sv);
  318.     if (op->op_flags & OPf_REF) {
  319.         PUSHs((SV*)av);
  320.         RETURN;
  321.     }
  322.     }
  323.     else {
  324.     if (SvTYPE(sv) == SVt_PVAV) {
  325.         av = (AV*)sv;
  326.         if (op->op_flags & OPf_REF) {
  327.         PUSHs((SV*)av);
  328.         RETURN;
  329.         }
  330.     }
  331.     else {
  332.         if (SvTYPE(sv) != SVt_PVGV) {
  333.         if (SvGMAGICAL(sv)) {
  334.             mg_get(sv);
  335.             if (SvROK(sv))
  336.             goto wasref;
  337.         }
  338.         if (!SvOK(sv)) {
  339.             if (op->op_flags & OPf_REF ||
  340.               op->op_private & HINT_STRICT_REFS)
  341.             DIE(no_usym, "an ARRAY");
  342.             RETPUSHUNDEF;
  343.         }
  344.         if (op->op_private & HINT_STRICT_REFS)
  345.             DIE(no_symref, "an ARRAY");
  346.         sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVAV);
  347.         }
  348.         av = GvAVn(sv);
  349.         if (op->op_private & OPpLVAL_INTRO)
  350.         av = save_ary(sv);
  351.         if (op->op_flags & OPf_REF) {
  352.         PUSHs((SV*)av);
  353.         RETURN;
  354.         }
  355.     }
  356.     }
  357.  
  358.     if (GIMME == G_ARRAY) {
  359.     I32 maxarg = AvFILL(av) + 1;
  360.     EXTEND(SP, maxarg);
  361.     Copy(AvARRAY(av), SP+1, maxarg, SV*);
  362.     SP += maxarg;
  363.     }
  364.     else {
  365.     dTARGET;
  366.     I32 maxarg = AvFILL(av) + 1;
  367.     PUSHi(maxarg);
  368.     }
  369.     RETURN;
  370. }
  371.  
  372. PP(pp_rv2hv)
  373. {
  374.  
  375.     dSP; dTOPss;
  376.  
  377.     HV *hv;
  378.  
  379.     if (SvROK(sv)) {
  380.       wasref:
  381.     hv = (HV*)SvRV(sv);
  382.     if (SvTYPE(hv) != SVt_PVHV)
  383.         DIE("Not a HASH reference");
  384.     if (op->op_private & OPpLVAL_INTRO)
  385.         hv = (HV*)save_svref((SV**)sv);
  386.     if (op->op_flags & OPf_REF) {
  387.         SETs((SV*)hv);
  388.         RETURN;
  389.     }
  390.     }
  391.     else {
  392.     if (SvTYPE(sv) == SVt_PVHV) {
  393.         hv = (HV*)sv;
  394.         if (op->op_flags & OPf_REF) {
  395.         SETs((SV*)hv);
  396.         RETURN;
  397.         }
  398.     }
  399.     else {
  400.         if (SvTYPE(sv) != SVt_PVGV) {
  401.         if (SvGMAGICAL(sv)) {
  402.             mg_get(sv);
  403.             if (SvROK(sv))
  404.             goto wasref;
  405.         }
  406.         if (!SvOK(sv)) {
  407.             if (op->op_flags & OPf_REF ||
  408.               op->op_private & HINT_STRICT_REFS)
  409.             DIE(no_usym, "a HASH");
  410.             RETSETUNDEF;
  411.         }
  412.         if (op->op_private & HINT_STRICT_REFS)
  413.             DIE(no_symref, "a HASH");
  414.         sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVHV);
  415.         }
  416.         hv = GvHVn(sv);
  417.         if (op->op_private & OPpLVAL_INTRO)
  418.         hv = save_hash(sv);
  419.         if (op->op_flags & OPf_REF) {
  420.         SETs((SV*)hv);
  421.         RETURN;
  422.         }
  423.     }
  424.     }
  425.  
  426.     if (GIMME == G_ARRAY) { /* array wanted */
  427.     *stack_sp = (SV*)hv;
  428.     return do_kv(ARGS);
  429.     }
  430.     else {
  431.     dTARGET;
  432.     if (HvFILL(hv)) {
  433.         sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
  434.         sv_setpv(TARG, buf);
  435.     }
  436.     else
  437.         sv_setiv(TARG, 0);
  438.     SETTARG;
  439.     RETURN;
  440.     }
  441. }
  442.  
  443. PP(pp_aassign)
  444. {
  445.     dSP;
  446.     SV **lastlelem = stack_sp;
  447.     SV **lastrelem = stack_base + POPMARK;
  448.     SV **firstrelem = stack_base + POPMARK + 1;
  449.     SV **firstlelem = lastrelem + 1;
  450.  
  451.     register SV **relem;
  452.     register SV **lelem;
  453.  
  454.     register SV *sv;
  455.     register AV *ary;
  456.  
  457.     HV *hash;
  458.     I32 i;
  459.     int magic;
  460.  
  461.     delaymagic = DM_DELAY;        /* catch simultaneous items */
  462.  
  463.     /* If there's a common identifier on both sides we have to take
  464.      * special care that assigning the identifier on the left doesn't
  465.      * clobber a value on the right that's used later in the list.
  466.      */
  467.     if (op->op_private & OPpASSIGN_COMMON) {
  468.         for (relem = firstrelem; relem <= lastrelem; relem++) {
  469.             /*SUPPRESS 560*/
  470.             if (sv = *relem)
  471.                 *relem = sv_mortalcopy(sv);
  472.         }
  473.     }
  474.  
  475.     relem = firstrelem;
  476.     lelem = firstlelem;
  477.     ary = Null(AV*);
  478.     hash = Null(HV*);
  479.     while (lelem <= lastlelem) {
  480.     sv = *lelem++;
  481.     switch (SvTYPE(sv)) {
  482.     case SVt_PVAV:
  483.         ary = (AV*)sv;
  484.         magic = SvSMAGICAL(ary) != 0;
  485.         
  486.         av_clear(ary);
  487.         i = 0;
  488.         while (relem <= lastrelem) {    /* gobble up all the rest */
  489.         sv = NEWSV(28,0);
  490.         assert(*relem);
  491.         sv_setsv(sv,*relem);
  492.         *(relem++) = sv;
  493.         (void)av_store(ary,i++,sv);
  494.         if (magic)
  495.             mg_set(sv);
  496.         }
  497.         break;
  498.     case SVt_PVHV: {
  499.         char *tmps;
  500.         SV *tmpstr;
  501.  
  502.         hash = (HV*)sv;
  503.         magic = SvSMAGICAL(hash) != 0;
  504.         hv_clear(hash);
  505.  
  506.         while (relem < lastrelem) {    /* gobble up all the rest */
  507.             STRLEN len;
  508.             if (*relem)
  509.             sv = *(relem++);
  510.             else
  511.             sv = &sv_no, relem++;
  512.             tmps = SvPV(sv, len);
  513.             tmpstr = NEWSV(29,0);
  514.             if (*relem)
  515.             sv_setsv(tmpstr,*relem);    /* value */
  516.             *(relem++) = tmpstr;
  517.             (void)hv_store(hash,tmps,len,tmpstr,0);
  518.             if (magic)
  519.             mg_set(tmpstr);
  520.         }
  521.         }
  522.         break;
  523.     default:
  524.         if (SvTHINKFIRST(sv)) {
  525.         if (SvREADONLY(sv) && curcop != &compiling) {
  526.             if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
  527.             DIE(no_modify);
  528.             if (relem <= lastrelem)
  529.             relem++;
  530.             break;
  531.         }
  532.         if (SvROK(sv))
  533.             sv_unref(sv);
  534.         }
  535.         if (relem <= lastrelem) {
  536.         sv_setsv(sv, *relem);
  537.         *(relem++) = sv;
  538.         }
  539.         else
  540.         sv_setsv(sv, &sv_undef);
  541.         SvSETMAGIC(sv);
  542.         break;
  543.     }
  544.     }
  545.     if (delaymagic & ~DM_DELAY) {
  546.     if (delaymagic & DM_UID) {
  547. #ifdef HAS_SETRESUID
  548.         (void)setresuid(uid,euid,(Uid_t)-1);
  549. #else /* not HAS_SETRESUID */
  550. #ifdef HAS_SETREUID
  551.         (void)setreuid(uid,euid);
  552. #else /* not HAS_SETREUID */
  553. #ifdef HAS_SETRUID
  554.         if ((delaymagic & DM_UID) == DM_RUID) {
  555.         (void)setruid(uid);
  556.         delaymagic =~ DM_RUID;
  557.         }
  558. #endif /* HAS_SETRUID */
  559. #endif /* HAS_SETRESUID */
  560. #ifdef HAS_SETEUID
  561.         if ((delaymagic & DM_UID) == DM_EUID) {
  562.         (void)seteuid(uid);
  563.         delaymagic =~ DM_EUID;
  564.         }
  565. #endif /* HAS_SETEUID */
  566.         if (delaymagic & DM_UID) {
  567.         if (uid != euid)
  568.             DIE("No setreuid available");
  569.         (void)setuid(uid);
  570.         }
  571. #endif /* not HAS_SETREUID */
  572.         uid = (int)getuid();
  573.         euid = (int)geteuid();
  574.     }
  575.     if (delaymagic & DM_GID) {
  576. #ifdef HAS_SETRESGID
  577.         (void)setresgid(gid,egid,(Gid_t)-1);
  578. #else /* not HAS_SETREGID */
  579. #ifdef HAS_SETREGID
  580.         (void)setregid(gid,egid);
  581. #else /* not HAS_SETREGID */
  582. #endif /* not HAS_SETRESGID */
  583. #ifdef HAS_SETRGID
  584.         if ((delaymagic & DM_GID) == DM_RGID) {
  585.         (void)setrgid(gid);
  586.         delaymagic =~ DM_RGID;
  587.         }
  588. #endif /* HAS_SETRGID */
  589. #ifdef HAS_SETRESGID
  590.         (void)setresgid(gid,egid,(Gid_t)-1);
  591. #else /* not HAS_SETREGID */
  592. #ifdef HAS_SETEGID
  593.         if ((delaymagic & DM_GID) == DM_EGID) {
  594.         (void)setegid(gid);
  595.         delaymagic =~ DM_EGID;
  596.         }
  597. #endif /* HAS_SETEGID */
  598.         if (delaymagic & DM_GID) {
  599.         if (gid != egid)
  600.             DIE("No setregid available");
  601.         (void)setgid(gid);
  602.         }
  603. #endif /* not HAS_SETRESGID */
  604. #endif /* not HAS_SETREGID */
  605.         gid = (int)getgid();
  606.         egid = (int)getegid();
  607.     }
  608.     tainting |= (euid != uid || egid != gid);
  609.     }
  610.     delaymagic = 0;
  611.     if (GIMME == G_ARRAY) {
  612.     if (ary || hash)
  613.         SP = lastrelem;
  614.     else
  615.         SP = firstrelem + (lastlelem - firstlelem);
  616.     RETURN;
  617.     }
  618.     else {
  619.     SP = firstrelem;
  620.     for (relem = firstrelem; relem <= lastrelem; ++relem) {
  621.         if (SvOK(*relem)) {
  622.         dTARGET;
  623.         
  624.         SETi(lastrelem - firstrelem + 1);
  625.         RETURN;
  626.         }
  627.     }
  628.     RETSETUNDEF;
  629.     }
  630. }
  631.  
  632. PP(pp_match)
  633. {
  634.     dSP; dTARG;
  635.     register PMOP *pm = cPMOP;
  636.     register char *t;
  637.     register char *s;
  638.     char *strend;
  639.     I32 global;
  640.     I32 safebase;
  641.     char *truebase;
  642.     register REGEXP *rx = pm->op_pmregexp;
  643.     I32 gimme = GIMME;
  644.     STRLEN len;
  645.  
  646.     if (op->op_flags & OPf_STACKED)
  647.     TARG = POPs;
  648.     else {
  649.     TARG = GvSV(defgv);
  650.     EXTEND(SP,1);
  651.     }
  652.     s = SvPV(TARG, len);
  653.     strend = s + len;
  654.     if (!s)
  655.     DIE("panic: do_match");
  656.  
  657.     if (pm->op_pmflags & PMf_USED) {
  658.     if (gimme == G_ARRAY)
  659.         RETURN;
  660.     RETPUSHNO;
  661.     }
  662.  
  663.     if (!rx->prelen && curpm) {
  664.     pm = curpm;
  665.     rx = pm->op_pmregexp;
  666.     }
  667.     truebase = t = s;
  668.     if (global = pm->op_pmflags & PMf_GLOBAL) {
  669.     rx->startp[0] = 0;
  670.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  671.         MAGIC* mg = mg_find(TARG, 'g');
  672.         if (mg && mg->mg_len >= 0)
  673.         rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
  674.     }
  675.     }
  676.     safebase = (gimme == G_ARRAY) || global;
  677.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  678.     SAVEINT(multiline);
  679.     multiline = pm->op_pmflags & PMf_MULTILINE;
  680.     }
  681.  
  682. play_it_again:
  683.     if (global && rx->startp[0]) {
  684.     t = s = rx->endp[0];
  685.     if (s > strend)
  686.         goto nope;
  687.     }
  688.     if (pm->op_pmshort) {
  689.     if (pm->op_pmflags & PMf_SCANFIRST) {
  690.         if (SvSCREAM(TARG)) {
  691.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  692.             goto nope;
  693.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  694.             goto nope;
  695.         else if (pm->op_pmflags & PMf_ALL)
  696.             goto yup;
  697.         }
  698.         else if (!(s = fbm_instr((unsigned char*)s,
  699.           (unsigned char*)strend, pm->op_pmshort)))
  700.         goto nope;
  701.         else if (pm->op_pmflags & PMf_ALL)
  702.         goto yup;
  703.         if (s && rx->regback >= 0) {
  704.         ++BmUSEFUL(pm->op_pmshort);
  705.         s -= rx->regback;
  706.         if (s < t)
  707.             s = t;
  708.         }
  709.         else
  710.         s = t;
  711.     }
  712.     else if (!multiline) {
  713.         if (*SvPVX(pm->op_pmshort) != *s ||
  714.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  715.         if (pm->op_pmflags & PMf_FOLD) {
  716.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  717.             goto nope;
  718.         }
  719.         else
  720.             goto nope;
  721.         }
  722.     }
  723.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  724.         SvREFCNT_dec(pm->op_pmshort);
  725.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  726.     }
  727.     }
  728.     if (!rx->nparens && !global) {
  729.     gimme = G_SCALAR;            /* accidental array context? */
  730.     safebase = FALSE;
  731.     }
  732.     if (regexec(rx, s, strend, truebase, 0,
  733.       SvSCREAM(TARG) ? TARG : Nullsv,
  734.       safebase)) {
  735.     curpm = pm;
  736.     if (pm->op_pmflags & PMf_ONCE)
  737.         pm->op_pmflags |= PMf_USED;
  738.     goto gotcha;
  739.     }
  740.     else
  741.     goto ret_no;
  742.     /*NOTREACHED*/
  743.  
  744.   gotcha:
  745.     if (gimme == G_ARRAY) {
  746.     I32 iters, i, len;
  747.  
  748.     iters = rx->nparens;
  749.     if (global && !iters)
  750.         i = 1;
  751.     else
  752.         i = 0;
  753.     EXTEND(SP, iters + i);
  754.     for (i = !i; i <= iters; i++) {
  755.         PUSHs(sv_newmortal());
  756.         /*SUPPRESS 560*/
  757.         if ((s = rx->startp[i]) && rx->endp[i] ) {
  758.         len = rx->endp[i] - s;
  759.         sv_setpvn(*SP, s, len);
  760.         }
  761.     }
  762.     if (global) {
  763.         truebase = rx->subbeg;
  764.         if (rx->startp[0] && rx->startp[0] == rx->endp[0])
  765.         ++rx->endp[0];
  766.         goto play_it_again;
  767.     }
  768.     RETURN;
  769.     }
  770.     else {
  771.     if (global) {
  772.         MAGIC* mg = 0;
  773.         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
  774.         mg = mg_find(TARG, 'g');
  775.         if (!mg) {
  776.         sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
  777.         mg = mg_find(TARG, 'g');
  778.         }
  779.         mg->mg_len = rx->startp[0] ? rx->endp[0] - truebase : -1;
  780.     }
  781.     RETPUSHYES;
  782.     }
  783.  
  784. yup:
  785.     ++BmUSEFUL(pm->op_pmshort);
  786.     curpm = pm;
  787.     if (pm->op_pmflags & PMf_ONCE)
  788.     pm->op_pmflags |= PMf_USED;
  789.     if (global) {
  790.     rx->subbeg = truebase;
  791.     rx->subend = strend;
  792.     rx->startp[0] = s;
  793.     rx->endp[0] = s + SvCUR(pm->op_pmshort);
  794.     goto gotcha;
  795.     }
  796.     if (sawampersand) {
  797.     char *tmps;
  798.  
  799.     if (rx->subbase)
  800.         Safefree(rx->subbase);
  801.     tmps = rx->subbase = savepvn(t, strend-t);
  802.     rx->subbeg = tmps;
  803.     rx->subend = tmps + (strend-t);
  804.     tmps = rx->startp[0] = tmps + (s - t);
  805.     rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
  806.     }
  807.     RETPUSHYES;
  808.  
  809. nope:
  810.     if (pm->op_pmshort)
  811.     ++BmUSEFUL(pm->op_pmshort);
  812.  
  813. ret_no:
  814.     if (global) {
  815.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  816.         MAGIC* mg = mg_find(TARG, 'g');
  817.         if (mg)
  818.         mg->mg_len = -1;
  819.     }
  820.     }
  821.     if (gimme == G_ARRAY)
  822.     RETURN;
  823.     RETPUSHNO;
  824. }
  825.  
  826. OP *
  827. do_readline()
  828. {
  829.     dSP; dTARGETSTACKED;
  830.     register SV *sv;
  831.     STRLEN tmplen = 0;
  832.     STRLEN offset;
  833.     FILE *fp;
  834.     register IO *io = GvIO(last_in_gv);
  835.     register I32 type = op->op_type;
  836.  
  837.     fp = Nullfp;
  838.     if (io) {
  839.     fp = IoIFP(io);
  840.     if (!fp) {
  841.         if (IoFLAGS(io) & IOf_ARGV) {
  842.         if (IoFLAGS(io) & IOf_START) {
  843.             IoFLAGS(io) &= ~IOf_START;
  844.             IoLINES(io) = 0;
  845.             if (av_len(GvAVn(last_in_gv)) < 0) {
  846.             SV *tmpstr = newSVpv("-", 1); /* assume stdin */
  847.             av_push(GvAVn(last_in_gv), tmpstr);
  848.             }
  849.         }
  850.         fp = nextargv(last_in_gv);
  851.         if (!fp) { /* Note: fp != IoIFP(io) */
  852.             (void)do_close(last_in_gv, FALSE); /* now it does*/
  853.             IoFLAGS(io) |= IOf_START;
  854.         }
  855.         }
  856.         else if (type == OP_GLOB) {
  857.         SV *tmpcmd = NEWSV(55, 0);
  858.         SV *tmpglob = POPs;
  859.         ENTER;
  860.         SAVEFREESV(tmpcmd);
  861. #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
  862.            /* since spawning off a process is a real performance hit */
  863.         {
  864. #include <descrip.h>
  865. #include <lib$routines.h>
  866. #include <nam.h>
  867. #include <rmsdef.h>
  868.             char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
  869.             char vmsspec[NAM$C_MAXRSS+1];
  870.             char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
  871.             char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
  872.             $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
  873.             FILE *tmpfp;
  874.             STRLEN i;
  875.             struct dsc$descriptor_s wilddsc
  876.                = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  877.             struct dsc$descriptor_vs rsdsc
  878.                = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
  879.             unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
  880.  
  881.             /* We could find out if there's an explicit dev/dir or version
  882.                by peeking into lib$find_file's internal context at
  883.                ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
  884.                but that's unsupported, so I don't want to do it now and
  885.                have it bite someone in the future. */
  886.             strcat(tmpfnam,tmpnam(NULL));
  887.             cp = SvPV(tmpglob,i);
  888.             for (; i; i--) {
  889.                if (cp[i] == ';') hasver = 1;
  890.                if (cp[i] == '.') {
  891.                    if (sts) hasver = 1;
  892.                    else sts = 1;
  893.                }
  894.                if (cp[i] == '/') {
  895.                   hasdir = isunix = 1;
  896.                   break;
  897.                }
  898.                if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
  899.                    hasdir = 1;
  900.                    break;
  901.                }
  902.             }
  903.             if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
  904.                 ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
  905.                 if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
  906.                 while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
  907.                                             &dfltdsc,NULL,NULL,NULL))&1)) {
  908.                     end = rstr + (unsigned long int) *rslt;
  909.                     if (!hasver) while (*end != ';') end--;
  910.                     *(end++) = '\n';  *end = '\0';
  911.                     for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
  912.                     if (hasdir) {
  913.                       if (isunix) trim_unixpath(SvPVX(tmpglob),rstr);
  914.                       begin = rstr;
  915.                     }
  916.                     else {
  917.                         begin = end;
  918.                         while (*(--begin) != ']' && *begin != '>') ;
  919.                         ++begin;
  920.                     }
  921.                     ok = (fputs(begin,tmpfp) != EOF);
  922.                 }
  923.                 if (cxt) (void)lib$find_file_end(&cxt);
  924.                 if (ok && sts != RMS$_NMF) ok = 0;
  925.                 if (!ok) {
  926.                     fp = NULL;
  927.                 }
  928.                 else {
  929.                    rewind(tmpfp);
  930.                    IoTYPE(io) = '<';
  931.                    IoIFP(io) = fp = tmpfp;
  932.                 }
  933.             }
  934.         }
  935. #else /* !VMS */
  936. #ifdef DOSISH
  937.         sv_setpv(tmpcmd, "perlglob ");
  938.         sv_catsv(tmpcmd, tmpglob);
  939.         sv_catpv(tmpcmd, " |");
  940. #else
  941. #ifdef CSH
  942.         sv_setpvn(tmpcmd, cshname, cshlen);
  943.         sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
  944.         sv_catsv(tmpcmd, tmpglob);
  945.         sv_catpv(tmpcmd, "'|");
  946. #else
  947.         sv_setpv(tmpcmd, "echo ");
  948.         sv_catsv(tmpcmd, tmpglob);
  949. #if 'z' - 'a' == 25
  950.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  951. #else
  952.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
  953. #endif
  954. #endif /* !CSH */
  955. #endif /* !MSDOS */
  956.         (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp);
  957.         fp = IoIFP(io);
  958. #endif /* !VMS */
  959.         LEAVE;
  960.         }
  961.     }
  962.     else if (type == OP_GLOB)
  963.         SP--;
  964.     }
  965.     if (!fp) {
  966.     if (dowarn)
  967.         warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
  968.     if (GIMME == G_SCALAR) {
  969.         (void)SvOK_off(TARG);
  970.         PUSHTARG;
  971.     }
  972.     RETURN;
  973.     }
  974.     if (GIMME == G_ARRAY) {
  975.     sv = sv_2mortal(NEWSV(57, 80));
  976.     offset = 0;
  977.     }
  978.     else {
  979.     sv = TARG;
  980.     (void)SvUPGRADE(sv, SVt_PV);
  981.     tmplen = SvLEN(sv);    /* remember if already alloced */
  982.     if (!tmplen)
  983.         Sv_Grow(sv, 80);    /* try short-buffering it */
  984.     if (type == OP_RCATLINE)
  985.         offset = SvCUR(sv);
  986.     else
  987.         offset = 0;
  988.     }
  989.     for (;;) {
  990.     if (!sv_gets(sv, fp, offset)) {
  991.         clearerr(fp);
  992.         if (IoFLAGS(io) & IOf_ARGV) {
  993.         fp = nextargv(last_in_gv);
  994.         if (fp)
  995.             continue;
  996.         (void)do_close(last_in_gv, FALSE);
  997.         IoFLAGS(io) |= IOf_START;
  998.         }
  999.         else if (type == OP_GLOB) {
  1000.         (void)do_close(last_in_gv, FALSE);
  1001.         }
  1002.         if (GIMME == G_SCALAR) {
  1003.         (void)SvOK_off(TARG);
  1004.         PUSHTARG;
  1005.         }
  1006.         RETURN;
  1007.     }
  1008.     IoLINES(io)++;
  1009.     XPUSHs(sv);
  1010.     if (tainting) {
  1011.         tainted = TRUE;
  1012.         SvTAINT(sv); /* Anything from the outside world...*/
  1013.     }
  1014.     if (type == OP_GLOB) {
  1015.         char *tmps;
  1016.  
  1017.         if (SvCUR(sv) > 0)
  1018.         SvCUR(sv)--;
  1019.         if (*SvEND(sv) == rschar)
  1020.         *SvEND(sv) = '\0';
  1021.         else
  1022.         SvCUR(sv)++;
  1023.         for (tmps = SvPVX(sv); *tmps; tmps++)
  1024.         if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  1025.             strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
  1026.             break;
  1027.         if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
  1028.         (void)POPs;        /* Unmatched wildcard?  Chuck it... */
  1029.         continue;
  1030.         }
  1031.     }
  1032.     if (GIMME == G_ARRAY) {
  1033.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  1034.         SvLEN_set(sv, SvCUR(sv)+1);
  1035.         Renew(SvPVX(sv), SvLEN(sv), char);
  1036.         }
  1037.         sv = sv_2mortal(NEWSV(58, 80));
  1038.         continue;
  1039.     }
  1040.     else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
  1041.         /* try to reclaim a bit of scalar space (only on 1st alloc) */
  1042.         if (SvCUR(sv) < 60)
  1043.         SvLEN_set(sv, 80);
  1044.         else
  1045.         SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
  1046.         Renew(SvPVX(sv), SvLEN(sv), char);
  1047.     }
  1048.     RETURN;
  1049.     }
  1050. }
  1051.  
  1052. PP(pp_enter)
  1053. {
  1054.     dSP;
  1055.     register CONTEXT *cx;
  1056.     I32 gimme;
  1057.  
  1058.     /*
  1059.      * We don't just use the GIMME macro here because it assumes there's
  1060.      * already a context, which ain't necessarily so at initial startup.
  1061.      */
  1062.  
  1063.     if (op->op_flags & OPf_KNOW)
  1064.     gimme = op->op_flags & OPf_LIST;
  1065.     else if (cxstack_ix >= 0)
  1066.     gimme = cxstack[cxstack_ix].blk_gimme;
  1067.     else
  1068.     gimme = G_SCALAR;
  1069.  
  1070.     ENTER;
  1071.  
  1072.     SAVETMPS;
  1073.     PUSHBLOCK(cx, CXt_BLOCK, sp);
  1074.  
  1075.     RETURN;
  1076. }
  1077.  
  1078. PP(pp_helem)
  1079. {
  1080.     dSP;
  1081.     SV** svp;
  1082.     SV *keysv = POPs;
  1083.     STRLEN keylen;
  1084.     char *key = SvPV(keysv, keylen);
  1085.     HV *hv = (HV*)POPs;
  1086.     I32 lval = op->op_flags & OPf_MOD;
  1087.  
  1088.     if (SvTYPE(hv) != SVt_PVHV)
  1089.     RETPUSHUNDEF;
  1090.     svp = hv_fetch(hv, key, keylen, lval);
  1091.     if (lval) {
  1092.     if (!svp || *svp == &sv_undef)
  1093.         DIE(no_helem, key);
  1094.     if (op->op_private & OPpLVAL_INTRO)
  1095.         save_svref(svp);
  1096.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  1097.         SV* sv = *svp;
  1098.         if (SvGMAGICAL(sv))
  1099.         mg_get(sv);
  1100.         if (!SvOK(sv)) {
  1101.         (void)SvUPGRADE(sv, SVt_RV);
  1102.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  1103.                 (SV*)newHV() : (SV*)newAV());
  1104.         SvROK_on(sv);
  1105.         SvSETMAGIC(sv);
  1106.         }
  1107.     }
  1108.     }
  1109.     PUSHs(svp ? *svp : &sv_undef);
  1110.     RETURN;
  1111. }
  1112.  
  1113. PP(pp_leave)
  1114. {
  1115.     dSP;
  1116.     register CONTEXT *cx;
  1117.     register SV **mark;
  1118.     SV **newsp;
  1119.     PMOP *newpm;
  1120.     I32 gimme;
  1121.  
  1122.     if (op->op_flags & OPf_SPECIAL) {
  1123.     cx = &cxstack[cxstack_ix];
  1124.     cx->blk_oldpm = curpm;    /* fake block should preserve $1 et al */
  1125.     }
  1126.  
  1127.     POPBLOCK(cx,newpm);
  1128.  
  1129.     if (op->op_flags & OPf_KNOW)
  1130.     gimme = op->op_flags & OPf_LIST;
  1131.     else if (cxstack_ix >= 0)
  1132.     gimme = cxstack[cxstack_ix].blk_gimme;
  1133.     else
  1134.     gimme = G_SCALAR;
  1135.  
  1136.     if (gimme == G_SCALAR) {
  1137.     if (op->op_private & OPpLEAVE_VOID)
  1138.         SP = newsp;
  1139.     else {
  1140.         MARK = newsp + 1;
  1141.         if (MARK <= SP)
  1142.         if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
  1143.             *MARK = TOPs;
  1144.         else
  1145.             *MARK = sv_mortalcopy(TOPs);
  1146.         else {
  1147.         MEXTEND(mark,0);
  1148.         *MARK = &sv_undef;
  1149.         }
  1150.         SP = MARK;
  1151.     }
  1152.     }
  1153.     else {
  1154.     for (mark = newsp + 1; mark <= SP; mark++)
  1155.         if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
  1156.         *mark = sv_mortalcopy(*mark);
  1157.         /* in case LEAVE wipes old return values */
  1158.     }
  1159.     curpm = newpm;    /* Don't pop $1 et al till now */
  1160.  
  1161.     LEAVE;
  1162.  
  1163.     RETURN;
  1164. }
  1165.  
  1166. PP(pp_iter)
  1167. {
  1168.     dSP;
  1169.     register CONTEXT *cx;
  1170.     SV *sv;
  1171.  
  1172.     EXTEND(sp, 1);
  1173.     cx = &cxstack[cxstack_ix];
  1174.     if (cx->cx_type != CXt_LOOP)
  1175.     DIE("panic: pp_iter");
  1176.  
  1177.     if (cx->blk_loop.iterix >= cx->blk_oldsp)
  1178.     RETPUSHNO;
  1179.  
  1180.     if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) {
  1181.     SvTEMP_off(sv);
  1182.     *cx->blk_loop.itervar = sv;
  1183.     }
  1184.     else
  1185.     *cx->blk_loop.itervar = &sv_undef;
  1186.  
  1187.     RETPUSHYES;
  1188. }
  1189.  
  1190. PP(pp_subst)
  1191. {
  1192.     dSP; dTARG;
  1193.     register PMOP *pm = cPMOP;
  1194.     PMOP *rpm = pm;
  1195.     register SV *dstr;
  1196.     register char *s;
  1197.     char *strend;
  1198.     register char *m;
  1199.     char *c;
  1200.     register char *d;
  1201.     STRLEN clen;
  1202.     I32 iters = 0;
  1203.     I32 maxiters;
  1204.     register I32 i;
  1205.     bool once;
  1206.     char *orig;
  1207.     I32 safebase;
  1208.     register REGEXP *rx = pm->op_pmregexp;
  1209.     STRLEN len;
  1210.     int force_on_match = 0;
  1211.  
  1212.     if (pm->op_pmflags & PMf_CONST)    /* known replacement string? */
  1213.     dstr = POPs;
  1214.     if (op->op_flags & OPf_STACKED)
  1215.     TARG = POPs;
  1216.     else {
  1217.     TARG = GvSV(defgv);
  1218.     EXTEND(SP,1);
  1219.     }
  1220.     s = SvPV(TARG, len);
  1221.     if (!SvPOKp(TARG))
  1222.     force_on_match = 1;
  1223.  
  1224.   force_it:
  1225.     if (!pm || !s)
  1226.     DIE("panic: do_subst");
  1227.  
  1228.     strend = s + len;
  1229.     maxiters = (strend - s) + 10;
  1230.  
  1231.     if (!rx->prelen && curpm) {
  1232.     pm = curpm;
  1233.     rx = pm->op_pmregexp;
  1234.     }
  1235.     safebase = ((!rx || !rx->nparens) && !sawampersand);
  1236.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  1237.     SAVEINT(multiline);
  1238.     multiline = pm->op_pmflags & PMf_MULTILINE;
  1239.     }
  1240.     orig = m = s;
  1241.     if (pm->op_pmshort) {
  1242.     if (pm->op_pmflags & PMf_SCANFIRST) {
  1243.         if (SvSCREAM(TARG)) {
  1244.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  1245.             goto nope;
  1246.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  1247.             goto nope;
  1248.         }
  1249.         else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
  1250.           pm->op_pmshort)))
  1251.         goto nope;
  1252.         if (s && rx->regback >= 0) {
  1253.         ++BmUSEFUL(pm->op_pmshort);
  1254.         s -= rx->regback;
  1255.         if (s < m)
  1256.             s = m;
  1257.         }
  1258.         else
  1259.         s = m;
  1260.     }
  1261.     else if (!multiline) {
  1262.         if (*SvPVX(pm->op_pmshort) != *s ||
  1263.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  1264.         if (pm->op_pmflags & PMf_FOLD) {
  1265.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  1266.             goto nope;
  1267.         }
  1268.         else
  1269.             goto nope;
  1270.         }
  1271.     }
  1272.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  1273.         SvREFCNT_dec(pm->op_pmshort);
  1274.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  1275.     }
  1276.     }
  1277.     once = !(rpm->op_pmflags & PMf_GLOBAL);
  1278.     if (rpm->op_pmflags & PMf_CONST) {    /* known replacement string? */
  1279.     c = SvPV(dstr, clen);
  1280.     if (clen <= rx->minlen) {
  1281.                     /* can do inplace substitution */
  1282.         if (regexec(rx, s, strend, orig, 0,
  1283.           SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1284.         if (force_on_match) {
  1285.             force_on_match = 0;
  1286.             s = SvPV_force(TARG, len);
  1287.             goto force_it;
  1288.         }
  1289.         if (rx->subbase)     /* oops, no we can't */
  1290.             goto long_way;
  1291.         d = s;
  1292.         curpm = pm;
  1293.         SvSCREAM_off(TARG);    /* disable possible screamer */
  1294.         if (once) {
  1295.             m = rx->startp[0];
  1296.             d = rx->endp[0];
  1297.             s = orig;
  1298.             if (m - s > strend - d) {    /* faster to shorten from end */
  1299.             if (clen) {
  1300.                 Copy(c, m, clen, char);
  1301.                 m += clen;
  1302.             }
  1303.             i = strend - d;
  1304.             if (i > 0) {
  1305.                 Move(d, m, i, char);
  1306.                 m += i;
  1307.             }
  1308.             *m = '\0';
  1309.             SvCUR_set(TARG, m - s);
  1310.             (void)SvPOK_only(TARG);
  1311.             SvSETMAGIC(TARG);
  1312.             PUSHs(&sv_yes);
  1313.             RETURN;
  1314.             }
  1315.             /*SUPPRESS 560*/
  1316.             else if (i = m - s) {    /* faster from front */
  1317.             d -= clen;
  1318.             m = d;
  1319.             sv_chop(TARG, d-i);
  1320.             s += i;
  1321.             while (i--)
  1322.                 *--d = *--s;
  1323.             if (clen)
  1324.                 Copy(c, m, clen, char);
  1325.             (void)SvPOK_only(TARG);
  1326.             SvSETMAGIC(TARG);
  1327.             PUSHs(&sv_yes);
  1328.             RETURN;
  1329.             }
  1330.             else if (clen) {
  1331.             d -= clen;
  1332.             sv_chop(TARG, d);
  1333.             Copy(c, d, clen, char);
  1334.             (void)SvPOK_only(TARG);
  1335.             SvSETMAGIC(TARG);
  1336.             PUSHs(&sv_yes);
  1337.             RETURN;
  1338.             }
  1339.             else {
  1340.             sv_chop(TARG, d);
  1341.             (void)SvPOK_only(TARG);
  1342.             SvSETMAGIC(TARG);
  1343.             PUSHs(&sv_yes);
  1344.             RETURN;
  1345.             }
  1346.             /* NOTREACHED */
  1347.         }
  1348.         do {
  1349.             if (iters++ > maxiters)
  1350.             DIE("Substitution loop");
  1351.             m = rx->startp[0];
  1352.             /*SUPPRESS 560*/
  1353.             if (i = m - s) {
  1354.             if (s != d)
  1355.                 Move(s, d, i, char);
  1356.             d += i;
  1357.             }
  1358.             if (clen) {
  1359.             Copy(c, d, clen, char);
  1360.             d += clen;
  1361.             }
  1362.             s = rx->endp[0];
  1363.         } while (regexec(rx, s, strend, orig, s == m,
  1364.             Nullsv, TRUE));    /* (don't match same null twice) */
  1365.         if (s != d) {
  1366.             i = strend - s;
  1367.             SvCUR_set(TARG, d - SvPVX(TARG) + i);
  1368.             Move(s, d, i+1, char);        /* include the Null */
  1369.         }
  1370.         (void)SvPOK_only(TARG);
  1371.         SvSETMAGIC(TARG);
  1372.         PUSHs(sv_2mortal(newSViv((I32)iters)));
  1373.         RETURN;
  1374.         }
  1375.         PUSHs(&sv_no);
  1376.         RETURN;
  1377.     }
  1378.     }
  1379.     else
  1380.     c = Nullch;
  1381.     if (regexec(rx, s, strend, orig, 0,
  1382.       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1383.     long_way:
  1384.     if (force_on_match) {
  1385.         force_on_match = 0;
  1386.         s = SvPV_force(TARG, len);
  1387.         goto force_it;
  1388.     }
  1389.     dstr = NEWSV(25, sv_len(TARG));
  1390.     sv_setpvn(dstr, m, s-m);
  1391.     curpm = pm;
  1392.     if (!c) {
  1393.         register CONTEXT *cx;
  1394.         PUSHSUBST(cx);
  1395.         RETURNOP(cPMOP->op_pmreplroot);
  1396.     }
  1397.     do {
  1398.         if (iters++ > maxiters)
  1399.         DIE("Substitution loop");
  1400.         if (rx->subbase && rx->subbase != orig) {
  1401.         m = s;
  1402.         s = orig;
  1403.         orig = rx->subbase;
  1404.         s = orig + (m - s);
  1405.         strend = s + (strend - m);
  1406.         }
  1407.         m = rx->startp[0];
  1408.         sv_catpvn(dstr, s, m-s);
  1409.         s = rx->endp[0];
  1410.         if (clen)
  1411.         sv_catpvn(dstr, c, clen);
  1412.         if (once)
  1413.         break;
  1414.     } while (regexec(rx, s, strend, orig, s == m, Nullsv,
  1415.         safebase));
  1416.     sv_catpvn(dstr, s, strend - s);
  1417.     sv_replace(TARG, dstr);
  1418.     (void)SvPOK_only(TARG);
  1419.     SvSETMAGIC(TARG);
  1420.     PUSHs(sv_2mortal(newSViv((I32)iters)));
  1421.     RETURN;
  1422.     }
  1423.     PUSHs(&sv_no);
  1424.     RETURN;
  1425.  
  1426. nope:
  1427.     ++BmUSEFUL(pm->op_pmshort);
  1428.     PUSHs(&sv_no);
  1429.     RETURN;
  1430. }
  1431.  
  1432. PP(pp_grepwhile)
  1433. {
  1434.     dSP;
  1435.  
  1436.     if (SvTRUEx(POPs))
  1437.     stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
  1438.     ++*markstack_ptr;
  1439.     LEAVE;                    /* exit inner scope */
  1440.  
  1441.     /* All done yet? */
  1442.     if (stack_base + *markstack_ptr > sp) {
  1443.     I32 items;
  1444.  
  1445.     LEAVE;                    /* exit outer scope */
  1446.     (void)POPMARK;                /* pop src */
  1447.     items = --*markstack_ptr - markstack_ptr[-1];
  1448.     (void)POPMARK;                /* pop dst */
  1449.     SP = stack_base + POPMARK;        /* pop original mark */
  1450.     if (GIMME != G_ARRAY) {
  1451.         dTARGET;
  1452.         XPUSHi(items);
  1453.         RETURN;
  1454.     }
  1455.     SP += items;
  1456.     RETURN;
  1457.     }
  1458.     else {
  1459.     SV *src;
  1460.  
  1461.     ENTER;                    /* enter inner scope */
  1462.     SAVESPTR(curpm);
  1463.  
  1464.     src = stack_base[*markstack_ptr];
  1465.     SvTEMP_off(src);
  1466.     GvSV(defgv) = src;
  1467.  
  1468.     RETURNOP(cLOGOP->op_other);
  1469.     }
  1470. }
  1471.  
  1472. PP(pp_leavesub)
  1473. {
  1474.     dSP;
  1475.     SV **mark;
  1476.     SV **newsp;
  1477.     PMOP *newpm;
  1478.     I32 gimme;
  1479.     register CONTEXT *cx;
  1480.  
  1481.     POPBLOCK(cx,newpm);
  1482.     POPSUB(cx);
  1483.  
  1484.     if (gimme == G_SCALAR) {
  1485.     MARK = newsp + 1;
  1486.     if (MARK <= SP)
  1487.         if (SvFLAGS(TOPs) & SVs_TEMP)
  1488.         *MARK = TOPs;
  1489.         else
  1490.         *MARK = sv_mortalcopy(TOPs);
  1491.     else {
  1492.         MEXTEND(mark,0);
  1493.         *MARK = &sv_undef;
  1494.     }
  1495.     SP = MARK;
  1496.     }
  1497.     else {
  1498.     for (mark = newsp + 1; mark <= SP; mark++)
  1499.         if (!(SvFLAGS(*mark) & SVs_TEMP))
  1500.         *mark = sv_mortalcopy(*mark);
  1501.         /* in case LEAVE wipes old return values */
  1502.     }
  1503.  
  1504.     if (cx->blk_sub.hasargs) {        /* You don't exist; go away. */
  1505.     AV* av = cx->blk_sub.argarray;
  1506.  
  1507.     av_clear(av);
  1508.     AvREAL_off(av);
  1509.     }
  1510.     curpm = newpm;    /* Don't pop $1 et al till now */
  1511.  
  1512.     LEAVE;
  1513.     PUTBACK;
  1514.     return pop_return();
  1515. }
  1516.  
  1517. PP(pp_entersub)
  1518. {
  1519.     dSP; dPOPss;
  1520.     GV *gv;
  1521.     HV *stash;
  1522.     register CV *cv;
  1523.     register CONTEXT *cx;
  1524.  
  1525.     if (!sv)
  1526.     DIE("Not a CODE reference");
  1527.     switch (SvTYPE(sv)) {
  1528.     default:
  1529.     if (!SvROK(sv)) {
  1530.         if (sv == &sv_yes)        /* unfound import, ignore */
  1531.         RETURN;
  1532.         if (!SvOK(sv))
  1533.         DIE(no_usym, "a subroutine");
  1534.         if (op->op_private & HINT_STRICT_REFS)
  1535.         DIE(no_symref, "a subroutine");
  1536.         gv = gv_fetchpv(SvPV(sv, na), FALSE, SVt_PVCV);
  1537.         if (!gv)
  1538.         cv = 0;
  1539.         else
  1540.         cv = GvCV(gv);
  1541.         break;
  1542.     }
  1543.     cv = (CV*)SvRV(sv);
  1544.     if (SvTYPE(cv) == SVt_PVCV)
  1545.         break;
  1546.     /* FALL THROUGH */
  1547.     case SVt_PVHV:
  1548.     case SVt_PVAV:
  1549.     DIE("Not a CODE reference");
  1550.     case SVt_PVCV:
  1551.     cv = (CV*)sv;
  1552.     break;
  1553.     case SVt_PVGV:
  1554.     if (!(cv = GvCV((GV*)sv)))
  1555.         cv = sv_2cv(sv, &stash, &gv, TRUE);
  1556.     break;
  1557.     }
  1558.  
  1559.     ENTER;
  1560.     SAVETMPS;
  1561.  
  1562.   retry:
  1563.     if (!cv)
  1564.     DIE("Not a CODE reference");
  1565.  
  1566.     if (!CvROOT(cv) && !CvXSUB(cv)) {
  1567.     if (gv = CvGV(cv)) {
  1568.         SV *tmpstr = sv_newmortal();
  1569.         GV *ngv;
  1570.         gv_efullname(tmpstr, gv);
  1571.         ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
  1572.         if (ngv && ngv != gv && (cv = GvCV(ngv))) {    /* One more chance... */
  1573.         gv = ngv;
  1574.         sv_setsv(GvSV(CvGV(cv)), tmpstr);    /* Set CV's $AUTOLOAD */
  1575.         goto retry;
  1576.         }
  1577.         else
  1578.         DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
  1579.     }
  1580.     DIE("Undefined subroutine called");
  1581.     }
  1582.  
  1583.     if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) {
  1584.     sv = GvSV(DBsub);
  1585.     save_item(sv);
  1586.     gv = CvGV(cv);
  1587.     gv_efullname(sv,gv);
  1588.     cv = GvCV(DBsub);
  1589.     if (!cv)
  1590.         DIE("No DBsub routine");
  1591.     }
  1592.  
  1593.     if (CvXSUB(cv)) {
  1594.     if (CvOLDSTYLE(cv)) {
  1595.         dMARK;
  1596.         register I32 items = SP - MARK;
  1597.         while (sp > mark) {
  1598.         sp[1] = sp[0];
  1599.         sp--;
  1600.         }
  1601.         stack_sp = mark + 1;
  1602.         items = (*(I32(*)_((int,int,int)))CvXSUB(cv))(CvXSUBANY(cv).any_i32,
  1603.                     MARK - stack_base + 1, items);
  1604.         stack_sp = stack_base + items;
  1605.     }
  1606.     else {
  1607.         PUTBACK;
  1608.         (void)(*CvXSUB(cv))(cv);
  1609.     }
  1610.     LEAVE;
  1611.     return NORMAL;
  1612.     }
  1613.     else {
  1614.     dMARK;
  1615.     register I32 items = SP - MARK;
  1616.     I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
  1617.     I32 gimme = GIMME;
  1618.     AV* padlist = CvPADLIST(cv);
  1619.     SV** svp = AvARRAY(padlist);
  1620.     push_return(op->op_next);
  1621.     PUSHBLOCK(cx, CXt_SUB, MARK);
  1622.     PUSHSUB(cx);
  1623.     CvDEPTH(cv)++;
  1624.     if (CvDEPTH(cv) < 2)
  1625.         (void)SvREFCNT_inc(cv);
  1626.     else {    /* save temporaries on recursion? */
  1627.         if (CvDEPTH(cv) == 100 && dowarn)
  1628.         warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
  1629.         if (CvDEPTH(cv) > AvFILL(padlist)) {
  1630.         AV *av;
  1631.         AV *newpad = newAV();
  1632.         I32 ix = AvFILL((AV*)svp[1]);
  1633.         svp = AvARRAY(svp[0]);
  1634.         while (ix > 0) {
  1635.             if (svp[ix] != &sv_undef) {
  1636.             char *name = SvPVX(svp[ix]);    /* XXX */
  1637.             if (*name == '@')
  1638.                 av_store(newpad, ix--, sv = (SV*)newAV());
  1639.             else if (*name == '%')
  1640.                 av_store(newpad, ix--, sv = (SV*)newHV());
  1641.             else
  1642.                 av_store(newpad, ix--, sv = NEWSV(0,0));
  1643.             SvPADMY_on(sv);
  1644.             }
  1645.             else {
  1646.             av_store(newpad, ix--, sv = NEWSV(0,0));
  1647.             SvPADTMP_on(sv);
  1648.             }
  1649.         }
  1650.         av = newAV();        /* will be @_ */
  1651.         av_extend(av, 0);
  1652.         av_store(newpad, 0, (SV*)av);
  1653.         AvFLAGS(av) = AVf_REIFY;
  1654.         av_store(padlist, CvDEPTH(cv), (SV*)newpad);
  1655.         AvFILL(padlist) = CvDEPTH(cv);
  1656.         svp = AvARRAY(padlist);
  1657.         }
  1658.     }
  1659.     SAVESPTR(curpad);
  1660.     curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
  1661.     if (hasargs) {
  1662.         AV* av = (AV*)curpad[0];
  1663.         SV** ary;
  1664.  
  1665.         if (AvREAL(av)) {
  1666.         av_clear(av);
  1667.         AvREAL_off(av);
  1668.         }
  1669.         cx->blk_sub.savearray = GvAV(defgv);
  1670.         cx->blk_sub.argarray = av;
  1671.         GvAV(defgv) = cx->blk_sub.argarray;
  1672.         ++MARK;
  1673.  
  1674.         if (items > AvMAX(av) + 1) {
  1675.         ary = AvALLOC(av);
  1676.         if (AvARRAY(av) != ary) {
  1677.             AvMAX(av) += AvARRAY(av) - AvALLOC(av);
  1678.             SvPVX(av) = (char*)ary;
  1679.         }
  1680.         if (items > AvMAX(av) + 1) {
  1681.             AvMAX(av) = items - 1;
  1682.             Renew(ary,items,SV*);
  1683.             AvALLOC(av) = ary;
  1684.             SvPVX(av) = (char*)ary;
  1685.         }
  1686.         }
  1687.         Copy(MARK,AvARRAY(av),items,SV*);
  1688.         AvFILL(av) = items - 1;
  1689.         
  1690.         while (items--) {
  1691.         if (*MARK)
  1692.             SvTEMP_off(*MARK);
  1693.         MARK++;
  1694.         }
  1695.     }
  1696.     RETURNOP(CvSTART(cv));
  1697.     }
  1698. }
  1699.  
  1700. PP(pp_aelem)
  1701. {
  1702.     dSP;
  1703.     SV** svp;
  1704.     I32 elem = POPi - curcop->cop_arybase;
  1705.     AV *av = (AV*)POPs;
  1706.     I32 lval = op->op_flags & OPf_MOD;
  1707.  
  1708.     if (SvTYPE(av) != SVt_PVAV)
  1709.     RETPUSHUNDEF;
  1710.     svp = av_fetch(av, elem, lval);
  1711.     if (lval) {
  1712.     if (!svp || *svp == &sv_undef)
  1713.         DIE(no_aelem, elem);
  1714.     if (op->op_private & OPpLVAL_INTRO)
  1715.         save_svref(svp);
  1716.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
  1717.         SV* sv = *svp;
  1718.         if (SvGMAGICAL(sv))
  1719.         mg_get(sv);
  1720.         if (!SvOK(sv)) {
  1721.         (void)SvUPGRADE(sv, SVt_RV);
  1722.         SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  1723.                 (SV*)newHV() : (SV*)newAV());
  1724.         SvROK_on(sv);
  1725.         SvSETMAGIC(sv);
  1726.         }
  1727.     }
  1728.     }
  1729.     PUSHs(svp ? *svp : &sv_undef);
  1730.     RETURN;
  1731. }
  1732.  
  1733. PP(pp_method)
  1734. {
  1735.     dSP;
  1736.     SV* sv;
  1737.     SV* ob;
  1738.     GV* gv;
  1739.     SV* nm;
  1740.  
  1741.     nm = TOPs;
  1742.     sv = *(stack_base + TOPMARK + 1);
  1743.     
  1744.     gv = 0;
  1745.     if (SvROK(sv))
  1746.     ob = SvRV(sv);
  1747.     else {
  1748.     GV* iogv;
  1749.     char* packname = 0;
  1750.  
  1751.     if (!SvOK(sv) ||
  1752.         !(packname = SvPV(sv, na)) ||
  1753.         !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
  1754.         !(ob=(SV*)GvIO(iogv)))
  1755.     {
  1756.         char *name = SvPV(nm, na);
  1757.         HV *stash;
  1758.         if (!packname || !isALPHA(*packname))
  1759. DIE("Can't call method \"%s\" without a package or object reference", name);
  1760.         if (!(stash = gv_stashpv(packname, FALSE))) {
  1761.         if (gv_stashpv("UNIVERSAL", FALSE))
  1762.             stash = gv_stashpv(packname, TRUE);
  1763.         else
  1764.             DIE("Can't call method \"%s\" in empty package \"%s\"",
  1765.             name, packname);
  1766.         }
  1767.         gv = gv_fetchmethod(stash,name);
  1768.         if (!gv)
  1769.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1770.             name, packname);
  1771.         SETs(gv);
  1772.         RETURN;
  1773.     }
  1774.     }
  1775.  
  1776.     if (!ob || !SvOBJECT(ob)) {
  1777.     char *name = SvPV(nm, na);
  1778.     DIE("Can't call method \"%s\" on unblessed reference", name);
  1779.     }
  1780.  
  1781.     if (!gv) {        /* nothing cached */
  1782.     char *name = SvPV(nm, na);
  1783.     gv = gv_fetchmethod(SvSTASH(ob),name);
  1784.     if (!gv)
  1785.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1786.         name, HvNAME(SvSTASH(ob)));
  1787.     }
  1788.  
  1789.     SETs(gv);
  1790.     RETURN;
  1791. }
  1792.  
  1793.